home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacFormat 1995 May
/
macformat-024.iso
/
Shareware City
/
Developers
/
TransSkel Pascal 2.5
/
TransEdit
/
TransEdit.p
< prev
next >
Encoding:
Amiga
Atari
Commodore
DOS
FM Towns/JPY
Macintosh
Macintosh JP
NeXTSTEP
RISC OS/Acorn
Shift JIS
UTF-8
Wrap
Text File
|
1994-12-12
|
41.9 KB
|
1,687 lines
|
[
TEXT/PJMM
]
{ TransEdit.c version 1.0 - TransSkel plug-in module supporting an}
{ arbitrary number of generic edit windows. Each window may be}
{ bound to a file.}
{ *** Requires FakeAlert.pas for proper linking! ***}
{ Shortcomings:}
{ Doesn't check for the obvious out of memory conditions.}
{ TransSkel and TransEdit are public domain, and are written by:}
{ Paul DuBois}
{ Wisconsin Regional Primate Research Center}
{ 1220 Capital Court}
{ Madison WI 53706 USA}
{ UUCP: {allegra,ihnp4,seismo}
{ The Pascal Version of TransSkel is public domain and was ported by }
{ Owen Hartnett }
{ Ωhm Software }
{ 163 Richard Drive }
{ Tiverton, RI 02878 }
{ CSNET: omh@cs.brown.edu.CSNET }
{ ARPA: omh%cs.brown.edu@relay.cs.net-relay.ARPA }
{ UUCP: [ihnp4,allegra]!brunix !omh }
{ modified 30 December 1987 by OH for changes to version 1.03 }
{ modified 2 December 1988 by OH for changes for LSP 2.0 and conditional }
{ compilation. You may now elect to allow only one edit window }
{ in your TransEdit program and save on code size. To effect, }
{ set the conditional compilation variable singleEdit to "true." }
{Ingemar's notes:}
{In order to get really modern, needs:}
{– Apple Event handling}
{– Replace hard coded strings with resources}
unit TransEdit;
interface
{$SETC singleEdit := false }
uses
FakeAlert, TransSkel;
type
SFReplyPtr = ^SFReply;
function EWindowClose (theWind: WindowPtr): boolean;
function IsEWindow (theWind: WindowPtr): Boolean;
function IsEWindowDirty (theWind: WindowPtr): Boolean;
function GetEWindowTE (theWind: WindowPtr): TEHandle;
function GetEWindowFile (theWind: WindowPtr; fileInfo: SFReplyPtr): Boolean;
procedure SetEWindowProcs (theWind: WindowPtr; pKey, pActivate, pClose: ProcPtr);
procedure SetEWindowStyle (theWind: WindowPtr; font, size, wrap, just: integer);
procedure EWindowOverhaul (theWind: WindowPtr; showCaret, recalc, dirty: Boolean);
procedure EWindowEditOp (item: integer);
procedure SetEWindowCreator (creat: OSType);
function EWindowSave (theWind: WindowPtr): Boolean;
function EWindowSaveAs (theWind: WindowPtr): Boolean;
function EWindowSaveCopy (theWind: WindowPtr): Boolean;
function EWindowRevert (theWind: WindowPtr): Boolean;
function NewEWindow (bounds: Rect; title: Str255; visible: Boolean; behind: WindowPtr; goAway: Boolean; refNum: longint; bindToFile: Boolean): WindowPtr;
function ClobberEWindows: Boolean;
procedure TransEditInit;
implementation
const
{ Edit window types, constants, variables.}
enter = 3;
cr = 13;
monaco = 4;
shiftKey = $200;
{ Edit menu item numbers }
undo = 1;
cut = 3;
copy = 4;
paste = 5;
clear = 6; { (it's ok if the host doesn't have this item) }
{ ewList points to a list of structures describing the known edit}
{ windows.}
{$IFC not singleEdit }
type
EIptr = ^EditInfoRec;
EIHandle = ^EIPtr;
EditInfoRec = record
editWind: WindowPtr;
bound: Boolean;
editFile: SFReply;
editTE: TEHandle;
dirty: Boolean;
scroll: ControlHandle;
visLines: integer;
eKey, eActivate, eClose: ProcPtr;
eNext: EIHandle;
end;
{$ENDC}
var
e_font, e_size, e_wrap, e_just: integer;
e_key, e_activate, e_close: ProcPtr;
{$IFC not singleEdit}
ewList: EIHandle;
{ Global variables - most of these are always synced to}
{ the current window. Note that not all these are set by}
{ SyncGlobals, since some are not often needed. When they}
{ are all needed, use SyncAllGlobals.}
editInfo: EIHandle; { window's info structure }
{$ENDC}
editWind: WindowPtr; { the window }
editTE: TEHandle; { window text }
editScroll: ControlHandle; { the scroll bar }
editFile: SFReply; { file information }
visLines: integer; { number of lines in window }
bound, dirty: Boolean; { true if window bound to file }
{ whether window is dirty }
eKey, eActivate, eClose: ProcPtr; { key click notifier }
{ activate event notifier }
{ close notifier }
windID: integer;
dlogWhere: Point; { GetFile/PutFile location }
creator: OSType; { default file creator }
clipRgn: RgnHandle;
procedure TransEditInit;
{Extra routine to do initialization of variables, LSP can't do this }
begin
{ Default values for edit window text display characteristics}
{ and event notification procedures}
e_font := monaco; { default font }
e_size := 9; { default pointsize }
e_wrap := 0; { default word wrap (on) }
e_just := teJustLeft;{ default justification }
e_key := nil; { default key procedure }
e_activate := nil; { default activation procedure }
e_close := nil; { default close procedure }
{$IFC not singleEdit}
ewList := nil;
{$ENDC}
editWind := nil;
windID := 0;
dlogWhere.v := 70;
dlogWhere.h := 100;
creator := 'TEDT';
end;
{ -------------------------------------------------------------------- }
{ Miscellaneous Internal (private) Routines }
{ -------------------------------------------------------------------- }
{ Save and restore the current window's clip region}
procedure SaveClipRgn;
begin
clipRgn := NewRgn;
GetClip(clipRgn);
end;
procedure RestoreClipRgn;
begin
SetClip(clipRgn);
DisposeRgn(clipRgn);
end;
{ Draw grow box in lower right hand corner of window.}
procedure DrawGrowBox;
var
r: Rect;
begin
SaveClipRgn;
r := editWind^.portRect;
r.left := r.right - 15;
r.top := r.bottom - 15; { draw only in corner }
ClipRect(r);
DrawGrowIcon(editWind);
RestoreClipRgn;
end;
{ -------------------------------------------------------------------- }
{ Lowest-level Internal (Private) Edit Window Routines }
{ -------------------------------------------------------------------- }
{$IFC not singleEdit}
{ Get edit window info associated with window.}
{ Return nil if window isn't a known edit window.}
function GetEInfo (theWind: WindowPtr): EIHandle;
var
h: EIHandle;
foundflag: Boolean;
begin
h := ewList;
foundflag := false; { set to true when window found !}
while h <> nil do
begin
if h^^.editWind = theWind then
begin
GetEInfo := h;
h := nil;
foundflag := true;
end
else
h := h^^.eNext;
end;
if foundflag = false then
GetEInfo := nil;
end;
{$ENDC}
{ Synchronize globals to an edit window and make it the}
{ current port. theWind must be a legal edit window, with one}
{ exception: if theWind is nil, the variables are synced to the}
{ port that's already current. That is safe (and correct) because:}
{ (i) nil is only passed by edit window handler procedures,}
{ which are only attached to edit windows}
{ (ii) TransSkel always sets the port to the window before}
{ calling the handler proc.}
{ Hence, using the current port under these circumstances always}
{ produces a legal edit window.}
procedure SyncGlobals (theWind: WindowPtr);
begin
if theWind = nil then { use current window }
GetPort(theWind);
SetPort(theWind);
{$IFC not singleEdit}
editWind := theWind;
editInfo := GetEInfo(editWind);
editTE := editInfo^^.editTE;
editScroll := editInfo^^.scroll;
visLines := editInfo^^.visLines;
{$ENDC}
end;
{$IFC singleEdit}
procedure SyncAllGlobals (theWind: Windowptr);
begin
if theWind = nil then { use current window }
GetPort(theWind);
SetPort(theWind);
end;
{$ELSEC}
procedure SyncAllGlobals (theWind: WindowPtr);
begin
SyncGlobals(theWind); { sync display globals }
editFile := editInfo^^.editFile;
bound := editInfo^^.bound; { procedure globals }
dirty := editInfo^^.dirty;
eKey := editInfo^^.eKey;
eActivate := editInfo^^.eActivate;
eClose := editInfo^^.eClose;
end;
{$ENDC}
{ Set dirty flag for current window}
procedure SetDirty (boolVal: Boolean);
begin
{$IFC singleEdit}
dirty := BoolVal;
{$ELSEC}
editInfo^^.dirty := boolVal;
{$ENDC}
end;
{ -------------------------------------------------------------------- }
{ Internal (private) Display Routines }
{ -------------------------------------------------------------------- }
{ Calculate the dimensions of the editing rectangle for}
{ editWind (which must be set properly and is assumed to be}
{ the current port). (The viewRect and destRect are the}
{ same size.) Assumes the port, text font and text size are all}
{ set properly. The viewRect is sized so that an integral}
{ number of lines can be displayed in it, i.e., so that a}
{ partial line never shows at the bottom. If that's not}
{ done, funny things can happen to the caret.}
procedure GetEditRect (var r: Rect);
var
f: FontInfo;
lineHeight: integer;
begin
GetFontInfo(f);
lineHeight := f.ascent + f.descent + f.leading;
r := editWind^.portRect;
r.left := r.left + 4;
r.right := r.right - 17; { leave room for scroll bar }
r.top := r.top + 2;
r.bottom := r.top + ((r.bottom - r.top - 2) div lineHeight) * lineHeight;
end;
{ Set the edit rect properly.}
procedure SetEditRect;
var
r: Rect;
begin
GetEditRect(r);
editTE^^.destRect.right := r.right;
editTE^^.viewRect := r;
end;
{ Calculate the dimensions of the scroll bar rectangle for}
{ editWind (which must be set properly). Make sure that}
{ the edges overlap the window frame and the grow box.}
procedure CalcScrollRect (var r: Rect);
begin
r := editWind^.portRect;
r.right := r.right + 1;
r.top := r.top - 1;
r.left := r.right - 16;
r.bottom := r.bottom - 14;
end;
{ Return true if the mouse is in the non-scrollbar part of the}
{ edit window.}
function PtInText (pt: Point): Boolean;
var
r: Rect;
begin
r := editWind^.portrect;
r.right := r.right - 15;
PtInText := PtInRect(pt, r);
end;
{ Set the cursor appropriately. If theCursor == iBeamCursor, check}
{ that it's really in the text area of an edit window (and if not}
{ set the cursor to an arrow instead). Otherwise, set the cursor}
{ to the given type (usually a watch).}
{ If the cursor is supposed to be set to an i-beam, it is assumed}
{ that the globals are synced, because DoCursor changes them and}
{ syncs them back.}
{ Pass -1 for theCursor to set the cursor to the arrow.}
procedure DoCursor (theCursor: integer);
var
pt: Point;
savePort: GrafPtr;
myCursor: CursHandle;
begin
if theCursor = iBeamCursor then { check whether there's an edit }
begin { window in front and if so, }
theCursor := -1; { whether the cursor's in its }
if (IsEWindow(FrontWindow)) then { text area }
begin
GetPort(savePort);
SyncGlobals(FrontWindow);
GetMouse(pt);
if (PtInText(pt)) then
theCursor := iBeamCursor;
SyncGlobals(savePort);
end;
end;
if theCursor = -1 then
{$IFC UNDEFINED THINK_PASCAL}
SetCursor(qd.arrow)
{$ELSEC}
SetCursor(arrow)
{$ENDC}
else
begin
myCursor := GetCursor(theCursor);
SetCursor(myCursor^^);
end;
end;
{ Calculate the number of lines currently scrolled off}
{ the top.}
function LinesOffTop: integer;
var
ePtr: TEPtr;
begin
ePtr := editTE^;
LinesOffTop := ((ePtr^.viewRect.top - ePtr^.destRect.top) div ePtr^.lineHeight);
end;
{ Return the line number that the caret (or the beginning of}
{ the currently selected text) is in. Value returned is in}
{ the range 0..(**editTE).nLines. If = (**editTE).nLines, the}
{ caret is past the last line. The only special case to watch out}
{{ for is when the caret is at the very end of the text. If the}
{ last character is not a carriage return, then the caret is on}
{{ the (nLines-1)th line, not the (nLines)th line.}
{{{ (This really should do a binary search for speed.){}
function LineWithCaret: integer;
var
i, nLines, teLength, selStart, lineStart: integer;
doneflag: Boolean;
mychars: CharsHandle;
begin
selStart := editTE^^.selStart;
nLines := editTE^^.nLines;
teLength := editTE^^.teLength;
if (selStart = teLength) then
begin
mychars := TEGetText(editTE);
if (teLength = 0) then
LineWithCaret := nLines
else if (mychars^^[teLength - 1] = char(cr)) then
LineWithCaret := nLines
else
LineWithCaret := nLines - 1
end
else
begin
i := 0;
doneflag := false; { Not done yet! }
while not doneflag do
begin
lineStart := editTE^^.lineStarts[i];
if lineStart >= selStart then
begin
if lineStart <> selStart then
i := i - 1;
LineWithCaret := i;
doneflag := true;
end;
i := i + 1;
end;
end;
end;
{ Return the number of the last displayable line. That's one}
{ more than nLines if the text is empty or the last character}
{ is a carriage return.}
function LastLine: integer;
var
nLines, teLength: integer;
mychars: CharsHandle;
begin
nLines := editTE^^.nLines;
teLength := editTE^^.teLength;
myChars := TEGetText(editTE);
if (teLength = 0) then
nLines := nLines + 1
else if (mychars^^[teLength - 1] = char(cr)) then
nLines := nLines + 1;
LastLine := nLines;
end;
{ Set the maximum value of the scroll bar. }
procedure SetScrollMax;
var
topLines, scrollableLines, max: integer;
begin
topLines := LinesOffTop;
scrollableLines := LastLine - visLines;
if topLines > scrollableLines then
max := topLines
else
max := scrollableLines;
if max < 0 then
max := 0;
if max <> GetCtlMax(editScroll) then
begin
SetCtlMax(editScroll, max);
if max > 0 then
HiliteControl(editScroll, 0)
else
HiliteControl(editScroll, 255);
end;
end;
{ Set scroll bar current value (but only if it's different than}
{ the current value, to avoid needless flashing).}
procedure SetScrollValue (value: integer);
begin
if GetCtlValue(editScroll) <> value then
SetCtlValue(editScroll, value);
end;
{ Scroll to the correct position. lDelta is the}
{ amount to CHANGE the current scroll setting by.}
procedure ScrollText (lDelta: integer);
var
topVisLine, newTopVisLine: integer;
begin
topVisLine := LinesOffTop;
newTopVisLine := topVisLine + lDelta;
if newTopVisLine < 0 then { clip to range }
newTopVisLine := 0;
if (newTopVisline > GetCtlMax(editScroll)) then
newTopVisLine := GetCtlMax(editScroll);
SetScrollValue(newTopVisLine);
TEScroll(0, (topVisLine - newTopVisLine) * editTE^^.lineHeight, editTE);
end;
{ Scroll to home position without redrawing.{}
procedure ScrollToHome;
var
r: Rect;
begin
r := editTE^^.destRect;
OffsetRect(r, 0, 2 - r.top);
editTE^^.destRect := r;
end;
{ ClikLoop proc for autoscrolling text when the mouse is dragged out}
{ of the text view rectangle.}
{ The clipping region has to be set to include the scroll bar,}
{ because whenever this proc is called, TE has the region set down}
{ to the view rectangle - if it's not reset, changes to the scroll}
{ bar will not show up!}
function AutoScroll: Boolean;
var
p: Point;
r: Rect;
begin
SaveClipRgn;
ClipRect(editWind^.portRect);
GetMouse(p);
r := editTE^^.viewRect;
if (p.v < r.top) then
ScrollText(-1)
else if (p.v > r.bottom) then
ScrollText(1);
RestoreClipRgn;
AutoScroll := true;
end;
{ Filter proc for tracking mousedown in scroll bar. The code for}
{ the part originally hit is shoved into the control's reference}
{ value by Mouse() before this is called.}
{ I suspect odd scrolling may occur for hits in paging regions if}
{ the window is allowed to size such that less than two lines show.}
procedure TrackScroll (theScroll: ControlHandle; partCode: integer);
var
lDelta: integer;
begin
if partCode = GetCRefCon(theScroll) then { still in same part? }
begin
case partCode of
inUpButton:
lDelta := -1;
inDownButton:
lDelta := 1;
inPageUp:
lDelta := -(visLines - 1);
inPageDown:
lDelta := visLines - 1;
otherwise
end;
ScrollText(lDelta);
end;
end;
{ Set the scroll bar properly and adjust the text in the}
{ window so that the line containing the caret is visible.}
{ If the line with the caret if more than a line outside of}
{ the viewRect, try to place it in the middle of the window.}
{}
{ Yes, it is necessary to SetScrollMax at the end.}
procedure AdjustDisplay;
var
caretLine, topVisLine, d: integer;
begin
SetScrollMax;
caretLine := LineWithCaret;
topVisLine := LinesOffTop;
d := caretLine - topVisLine;
if d < 0 then
if d = -1 then
ScrollText(-1)
else
ScrollText(d - (visLines div 2))
else
begin
d := caretLine - (topVisLine + visLines - 1);
if d > 0 then
if d = 1 then
ScrollText(1)
else
ScrollText(d + (visLines div 2))
else
SetScrollValue(topVisLine);
end;
SetScrollMax; { might have changed from scrolling }
end;
{ Overhaul the entire display. This is called for major}
{ catastrophes, such as resizing the window, or changes to}
{ the word wrap style. It makes sure the view and}
{ destination rectangles are sized properly, and that the bottom}
{ line of text never scrolls up past the bottom line of the}
{ window, if there's enough to fill the window, and that the}
{ scroll bar max and current values are set properly.}
{ Resizing the dest rect just means resetting the right edge}
{ (the top is NOT reset), since text might be scrolled off the}
{ top (i.e., destRect.top != 0).}
{ Doesn't redraw the control, though!}
procedure OverhaulDisplay (showCaret: Boolean; recalc: Boolean);
var
r: Rect;
begin
r := editTE^^.viewRect;
EraseRect(r); { erase current viewRect }
SetEditRect; { recalculate editing rects }
if recalc then { recalculate line starts }
TECalText(editTE);
visLines := (editTE^^.viewRect.bottom - editTE^^.viewRect.top) div editTE^^.lineHeight;
{$IFC not singleEdit}
editInfo^^.visLines := visLines;
{$ENDC}
if showCaret then
AdjustDisplay
else
SetScrollMax;
r := editTE^^.viewRect;
TEUpdate(r, editTE);
end;
{ ---------------------------------------------------------------- }
{ Window Handler Routines }
{ ---------------------------------------------------------------- }
{}
{ Handle mouse clicks in window. The viewRect is never tested}
{ directly, because if it were, clicks along the top, left and}
{ bottom edges of the window wouldn't register.}
procedure Mouse (thePt: Point; t: longint; mods: integer);
var
thePart, oldCtlValue, ignore: integer;
begin
SyncGlobals(nil); { sync to current port }
thePart := TestControl(editScroll, thePt);
if thePart = inThumb then
begin
oldCtlValue := GetCtlValue(editScroll);
if TrackControl(editScroll, thePt, nil) = inThumb then
ScrollText(GetCtlValue(editScroll) - oldCtlValue)
end
else if thePart <> 0 then
begin
SetCRefCon(editScroll, longint(thePart));
ignore := TrackControl(editScroll, thePt, @TrackScroll);
end
else if (PtInText(thePt)) then
TEClick(thePt, BitAnd(mods, shiftKey) <> 0, editTE);
SetScrollMax;
end;
procedure callpnoarg (myProc: ProcPtr);
{ For all the Procedures that are called with no arguments }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
procedure callpBoolean (myBool: Boolean; myProc: ProcPtr);
{ Two calls use Booleans as one parameter arguments. This procedure handles }
{ both of them. }
inline
$205f, {movea.l (a7)+,a0 ; (a0) is a ptr to string, 4(a0) is mode}
$4e90;
{ Handle key clicks in window}
procedure Key (c: char; mods: integer);
begin
SyncAllGlobals(nil); { sync to current port }
if c <> char(enter) then
TEKey(c, editTE);
AdjustDisplay;
SetDirty(true);
if eKey <> nil then { report event to the host }
callpnoarg(eKey);
end;
{ When the window comes active, highlight the scroll bar appropriately.}
{ When the window is deactivated, un-highlight the scroll bar.}
{ Redraw the grow box in any case. Set the cursor (DoCursor avoids}
{ changing it from an ibeam to an arrow back to an ibeam, in the case}
{ where one edit window is going inactive and another is coming}
{ active).}
{}
{ Report the event to the host.}
procedure Activate (active: Boolean);
begin
SyncAllGlobals(nil); { sync to current port }
DrawGrowBox;
if active then
begin
TEActivate(editTE);
if GetCtlMax(editScroll) > 0 then
HiliteControl(editScroll, 0)
else
HiliteControl(editScroll, 255);
end
else
begin
TEDeactivate(editTE);
HiliteControl(editScroll, 255);
end;
DoCursor(iBeamCursor);
if (eActivate <> nil) then { report event to the host }
callpBoolean(active, eActivate);
end;
{ Close box was clicked. If user specified notify proc, call it.}
{ Otherwise do default close operation (ask about saving if dirty,}
{ etc.).}
procedure Close;
var
ignore: integer;
begin
SyncAllGlobals(nil); { sync to current port }
if eclose <> nil then
callpnoarg(eClose)
else
ignore := integer(EWindowClose(editWind));
end;
{ Update window. The update event might be in response to a}
{ window resizing. If so, move and resize the scroll bar.}
{ The ValidRect call is done because the HideControl adds the}
{ control bounds box to the update region - which would generate}
{ another update event! Since everything gets redrawn below,}
{ the ValidRect is used to cancel the update.}
procedure UpDate (resized: Boolean);
var
r: Rect;
begin
SyncGlobals(nil); { sync to current port }
r := editWind^.portRect;
EraseRect(r);
if resized then
begin
HideControl(editScroll);
r := editScroll^^.contrlRect;
ValidRect(r);
CalcScrollRect(r);
SizeControl(editScroll, 16, r.bottom - r.top);
MoveControl(editScroll, r.left, r.top);
OverhaulDisplay(false, editTE^^.crOnly >= 0);
ShowControl(editScroll);
end
else
begin
OverhaulDisplay(false, false);
DrawControls(editWind);
end;
DrawGrowBox;
end;
{ Remove the edit window from the list, and dispose of it.}
{ This is called by SkelRmveWind, not directly by user program.}
{}
{ At this point it's too late to back out if any changes have been}
{ made to the text.}
{ Since the clobber procedure is never called except for real edit}
{ windows, and since the list must therefore be non-empty, it is}
{ not necessary to check the legality of the window or that the}
{ window's in the list.}
procedure Clobber;
{$IFC not singleEdit}
var
h, h2: EIHandle;
{$ENDC}
begin
SyncGlobals(nil); { sync to current port }
{$IFC not singleEdit}
if ewList^^.editWind = editWind then { is it the first window in list? }
begin
h2 := ewList;
ewList := ewList^^.eNext;
end
else
begin
h := ewList;
while h <> nil do
begin
h2 := h^^.eNext;
if h2^^.editWind = editWind then { found it }
begin
h^^.eNext := h2^^.eNext;
h := nil;
end;
if h <> nil then
h := h2;
end;
end;
DisposHandle(Handle(h2)); { get rid of information structure }
{$ENDC}
TEDispose(editTE); { toss text record }
DisposeWindow(editWind); { disposes of scroll bar, too }
editWind := nil;
DoCursor(iBeamCursor);
end;
{ Blink the caret and make sure the cursor's an i-beam when it's}
{ in the non-scrollbar part of the window.}
procedure Idle;
begin
SyncGlobals(nil);
TEIdle(editTE); { blink that caret! }
DoCursor(iBeamCursor);
end;
{ ---------------------------------------------------------------- }
{ Internal File Routines }
{ ---------------------------------------------------------------- }
procedure ErrMesg (s: Str255);
var
ignore: integer;
begin
ignore := FakeAlert(s, '', '', '', 1, 1, 'OK', '', '');
end;
{ Save the contents of the edit window. If there is no file bound}
{ to the window, ask for a file name. If askForFile is true, ask}
{ for a name even if the window is currently bound to a file. If}
{ bindToFile is true, bind the window to the file written to (if}
{ that's different than the currently bound file), and clear the}
{ window's dirty flag.}
{ Return true if the file was written without error. Return false}
{ if (a) user was asked for name and clicked Cancel (b) there was}
{ some error writing the file. In the latter case, the window is}
{ not bound to any new name given by user.}
{ Always returns false if the window isn't an edit window. This}
{ simplifies EWindowSave, EWindowSaveAs, EWindowSaveCopy. (They}
{ don't do the test.)}
function SaveFile (theWind: WindowPtr; askForFile: Boolean; bindToFile: Boolean): Boolean;
var
f: integer;
fndrInfo: FInfo; { finder info }
tmpFile: SFReply;
hText: Handle;
count: longint;
result, ignore: OSErr;
haveNewFile, breakflag: Boolean;
begin
haveNewFile := false;
breakflag := false; { flag to detect a C 'return' statement }
if not IsEWindow(theWind) then
begin
SaveFile := false;
breakflag := true;
end
else
begin
SyncAllGlobals(theWind);
tmpFile := editFile;
if (bound = false) or askForFile then
begin
SFPutFile(dlogWhere, 'Save File as:', editFile.fName, nil, tmpFile);
if not tmpFile.good then
begin
SaveFile := false;
breakflag := true;
end
else
begin
haveNewFile := true;
if GetFInfo(tmpFile.fName, tmpFile.vRefNum, fndrInfo) = noErr then { exists }
begin
if fndrInfo.fdType <> 'TEXT' then
begin
ErrMesg('Not a TEXT File');
SaveFile := false;
breakflag := true;
end
end
else { doesn't exist. create it. }
begin
if (Create(tmpFile.fName, tmpFile.vRefNum, creator, 'TEXT') <> noErr) then
begin
ErrMesg('Can''t Create');
SaveFile := false;
breakflag := true;
end;
end;
end;
end;
end;
if not breakflag then
begin
if FSOpen(tmpFile.fName, tmpFile.vRefNum, f) <> noErr then
ErrMesg('Can''t Open')
else
begin
DoCursor(watchCursor);
ignore := SetFPos(f, fsFromStart, longint(0));
hText := editTE^^.hText;
HLock(hText);
count := editTE^^.teLength;
result := FSWrite(f, count, hText^);
ignore := GetFPos(f, count);
ignore := SetEOF(f, count);
ignore := FSClose(f);
ignore := FlushVol(nil, tmpFile.vRefNum);
HUnlock(hText);
DoCursor(iBeamCursor);
if result = noerr then
begin
if bindToFile then
begin
SetDirty(false);
if haveNewFile then
begin
SetWTitle(editWind, tmpFile.fName);
{$IFC singleEdit}
bound := true;
editFile := tmpFile;
{$ELSEC}
editInfo^^.bound := true;
editInfo^^.editFile := tmpFile;
{$ENDC}
end;
end;
SaveFile := true;
breakflag := true;
end
else
ErrMesg('Write error!');
end;
if not breakflag then
SaveFile := false;
end;
end;
{ Revert to version of file saved on disk. Doesn't check whether}
{ the window's really bound to a file or not, doesn't ask whether}
{ to really revert if the window's dirty, does no redrawing, etc.}
{ Just reports whether the file was read in successfully.}
function Revert: Boolean;
var
result: Boolean;
f: integer;
len: longint;
h: Handle;
ignore: OSErr;
begin
result := false;
DoCursor(watchCursor);
if FSOpen(editFile.fName, editFile.vRefNum, f) <> noErr then
ErrMesg('Couldn''t open file')
else
begin
ignore := GetEOF(f, len);
if len >= 32000 then
ErrMesg('File is too big')
else
begin
h := Handle(TEGetText(editTE));
SetHandleSize(h, len);
HLock(h);
ignore := FSRead(f, len, h^);
HUnlock(h);
editTE^^.teLength := len;
TESetSelect(longint(0), longint(0), editTE); { set caret at start }
result := true;
SetDirty(false);
end;
ignore := FSClose(f);
end;
DoCursor(iBeamCursor);
Revert := result;
end;
{ ------------------------------------------------------------ }
{ Lowest-level Interface (Public) Routines }
{ ------------------------------------------------------------ }
{}
{ Return true/false to indicate whether the window is really an}
{ edit window.}
function IsEWindow;
begin
{$IFC singleEdit}
ISEWindow := (theWind = editWind) & (editWind <> nil);
{$ELSEC}
IsEWindow := GetEInfo(theWind) <> nil;
{$ENDC}
end;
{ Return true/false to indicate whether the text associated with}
{ the window has been changed since the last save/revert (or since}
{ created, if not bound to file).}
function IsEWindowDirty;
{$IFC not singleEdit}
var
eInfo: EIHandle;
{$ENDC}
begin
{$IFC not singleEdit}
eInfo := GetEInfo(theWind);
if eInfo <> nil then
IsEWindowDirty := eInfo^^.dirty
else
IsEwindowDirty := false;
{$ELSEC}
if (IsEWindow(theWind)) then
IsEWindowDirty := dirty
else
IsEWindowDirty := false;
{$ENDC}
end;
{ Return a handle to the TextEdit record associated with the edit}
{ window, or nil if it's not an edit window}
function GetEWindowTE;
{$IFC not singleEdit}
var
eInfo: EIHandle;
{$ENDC}
begin
{$IFC not singleEdit}
eInfo := GetEInfo(theWind);
if eInfo <> nil then
GetEWindowTE := eInfo^^.editTE
else
GetEWindowTE := nil;
{$ELSEC}
if IsEWindow(theWind) then
GetEWindowTE := editTE
else
GetEWindowTE := nil;
{$ENDC}
end;
{ Return true/false depending on whether the editor is bound to}
{ a file or not, and a copy of the file info in the second}
{ argument. Pass nil for fileInfo if only want the return status.}
{ Returns false if it's not an edit window.}
function GetEWindowFile;
{$IFC not singleEdit}
var
eInfo: EIHandle;
{$ENDC}
begin
{$IFC not singleEdit}
eInfo := GetEInfo(theWind);
if eInfo <> nil then
begin
if fileInfo <> nil then
fileInfo^ := eInfo^^.editFile;
GetEWindowFile := eInfo^^.bound
end
else
GetEWindowFile := false;
{$ELSEC}
if IsEWindow(theWind) then
begin
if fileInfo <> nil then
fileInfo^ := editFile;
GetEWindowFile := bound;
end
else
GetEWindowFile := false;
{$ENDC}
end;
{ ---------------------------------------------------------------- }
{ Interface Display Routines }
{ ---------------------------------------------------------------- }
{}
{ Install event notification procedures for an edit window.}
procedure SetEWindowProcs;
{$IFC not singleEdit}
var
eInfo: EIHandle;
{$ENDC}
begin
if theWind = nil then { reset window creation defaults }
begin
e_key := pKey;
e_activate := pActivate;
e_close := pClose;
end
else
{$IFC not singleEdit}
begin
eInfo := GetEInfo(theWind);
if eInfo <> nil then
begin
eInfo^^.eKey := pKey;
eInfo^^.eActivate := pActivate;
eInfo^^.eClose := pClose;
end;
end;
{$ELSEC}
begin
if IsEWindow(theWind) then
begin
eKey := pKey;
eActivate := pActivate;
eClose := pClose;
end;
end;
{$ENDC}
end;
{ Change the text display characteristics of an edit window}
{ and redisplay it.}
{ Scroll to home position before overhauling, because although}
{ the overhaul sets the viewRect to display an integral number}
{ of lines, there's no guarantee that the destRect offset will}
{ also be integral except at home position. Clipping is set to}
{ an empty rect so the scroll doesn't show.}
procedure SetEWindowStyle;
var
savePort: GrafPtr;
f: FontInfo;
te: TEHandle;
r: Rect;
oldWrap: integer;
begin
if theWind = nil then { reset window creation defaults }
begin
e_font := font;
e_size := size;
e_wrap := wrap;
e_just := just;
end
else if IsEWindow(theWind) then
begin
GetPort(savePort);
SyncGlobals(theWind); { sync and set port }
te := editTE;
ScrollToHome;
oldWrap := te^^.crOnly;
te^^.crOnly := wrap;
TESetJust(just, te); { set justification }
TextFont(font); { set the font and point size }
TextSize(size); { of text record }
GetFontInfo(f);
te^^.lineHeight := f.ascent + f.descent + f.leading;
te^^.fontAscent := f.ascent;
te^^.txFont := font;
te^^.txSize := size;
OverhaulDisplay(true, (oldWrap >= 0) or (wrap >= 0));
SetPort(savePort);
end;
end;
{ Redo display. Does not save current port. This is used by hosts}
{ that mess with the text externally to TransEdit. The arguments}
{ determine whether the text is scrolled to show the line with the}
{ caret, whether the lineStarts are recalculated, and whether the}
{ text should be marked dirty or not.}
procedure EWindowOverhaul;
begin
if (IsEWindow(theWind)) then
begin
SyncGlobals(theWind);
OverhaulDisplay(showCaret, recalc);
DrawControls(editWind);
SetDirty(dirty);
end;
end;
{ ---------------------------------------------------------------- }
{ Menu Interface Routine }
{ ---------------------------------------------------------------- }
{}
{ Do Edit menu selection. This is only valid if an edit}
{ window is frontmost.}
procedure EWindowEditOp;
var
ignore: integer;
begin
if IsEWindow(FrontWindow) then
begin
SyncGlobals(FrontWindow);
case item of
{ cut selection, put in TE Scrap, clear clipboard and put}
{ TE scrap in it}
cut:
begin
TECut(editTE);
ignore := ZeroScrap;
ignore := TEToScrap;
end;
{ copy selection to TE Scrap, clear clipboard and put}
{ TE scrap in it}
copy:
begin
TECopy(editTE);
ignore := ZeroScrap;
ignore := TEToScrap;
end;
{ get clipboard into TE scrap, put TE scrap into edit record}
paste:
begin
ignore := TEFromScrap;
TEPaste(editTE);
end;
{ delete selection without putting into TE scrap or clipboard}
clear:
TEDelete(editTE);
otherwise
end;
AdjustDisplay;
SetDirty(true);
end;
end;
{ ---------------------------------------------------------------- }
{ Interface File Routines }
{ ---------------------------------------------------------------- }
{}
{ Set file creator for any files created by TransEdit}
procedure SetEWindowCreator;
begin
creator := creat;
end;
{ Save the contents of the given window}
function EWindowSave;
begin
EWindowSave := SaveFile(theWind, false, true); { window to save }
{ don't ask for file if have one }
{ bind to new file if one given }
end;
{ Save the contents of the given window under a new name}
{ and bind to that name.}
function EWindowSaveAs;
begin
EWindowSaveAs := SaveFile(theWind, true, true);{ window to save }
{ ask for file even if have one }
{ bind to new file if one given }
end;
{ Save the contents of the given window under a new name, but}
{ don't bind to the name.}
function EWindowSaveCopy;
begin
EWindowSaveCopy := SaveFile(theWind, true, false); { window to save }
{ ask for file even if have one }
{ don't bind to file }
end;
{ Close the window. If it's dirty and is either bound to a file}
{ or (if not bound) has some text in it, ask about saving it first,}
{ giving user option of saving changes, tossing them, or}
{ cancelling altogether.}
{ Return true if the file was saved and the window closed, false if}
{ user cancelled or there was an error.}
function EWindowClose;
var
return: Boolean;
begin
return := true;
if IsEWindow(theWind) = true then
begin
SyncAllGlobals(theWind);
if ((bound or (editTE^^.teLength > 0)) and dirty) then
case (FakeAlert('Save changes to"', editFile.fName, '"?', '', 3, 3, 'Cancel', 'Discard', 'Save')) of
1: { cancel Close }
return := false;
2:
; { toss changes }
3:
if SaveFile(editWind, false, false) = false then { window to save }
{ don't ask for name }
{ don't bind to name }
return := false; { cancelled or error - cancel Close }
otherwise
end;
if return then
SkelRmveWind(editWind);
EWindowClose := return;
end;
end;
{ Revert to saved version of file on disk. theWind must be an edit}
{ window, and must be bound to a file. Returns false if one of these}
{ conditions is not met, or if they are met but there was an error}
{ reading the file.}
{ The window need not be dirty, but if it is, the user is asked}
{ whether to really revert.}
function EWindowRevert;
var
return: Boolean;
begin
return := true;
if not IsEWindow(theWind) then
return := false
else
begin
SyncAllGlobals(theWind);
if not bound then { no file to revert to }
return := false
else
begin
if dirty then
if FakeAlert('"', editFile.fName, '" has been changed. Really revert?', '', 2, 1, 'Cancel', 'Revert', '') = 1 then
return := false;
end;
end;
if return = true then
if Revert = false then
return := false;
if return = true then
begin
ScrollToHome;
OverhaulDisplay(true, true);
DrawControls(editWind);
ValidRect(editWind^.portRect);
end;
EWindowRevert := return;
end;
{ ---------------------------------------------------------------- }
{ Interface Initialization/Termination Routines }
{ ---------------------------------------------------------------- }
{}
{ Initialize the window and associated data structures.}
{ Return window pointer or nil if some sort of error.}
{}
{ Preserves the current port.}
function NewEWindow;
var
savePort: GrafPtr;
r: Rect;
mytype: SFTypeList;
s, s2: Str255;
tPtr: string[64];
{$IFC not singleEdit}
eInfo: EIHandle;
{$ENDC}
failure: Boolean;
dummy: Boolean;
begin
{$IFC singleEdit}
if editWind <> nil then
begin
NewEWindow := nil;
exit(NewEWindow);
end;
{$ENDC}
mytype[0] := 'TEXT';
failure := false; {no failure yet!}
if bindToFile then
{ If supposed to bind to file, ask for name. Return without doing}
{ anything if Cancel button clicked.}
begin
SFGetFile(dlogWhere, '', nil, 1, myType, nil, editFile);
if not editFile.good then
failure := true
end;
if not failure then
begin
bound := bindToFile;
if bound then
{ Create window and install handler. Set window title: If window is}
{ to be bound to file, use name of file. Otherwise use any title that}
{ was passed in. If nil was passed, use a default name ("Untitled nnn").}
{ Also copy the name into the file info structure even if the window is}
{ unbound, because the Save operations expect to find it there as the}
{ most likely name to use if the window is untitled.}
{ Save and restore port, because it gets reset by the rest of the}
{ initialization code.}
tPtr := editFile.fName
else
begin
if title <> '' then
tPtr := title
else
begin
{$IFC not singleEdit}
windId := windID + 1; { Who's says C is easier? The C code for this }
NumToString(longint(windID), s2); { is ridiculous!!!!! }
tPtr := concat('Untitled ', s2);
{$ELSEC}
tPtr := 'Untitled';
{$ENDC}
end;
editFile.fName := tPtr;
end;
editWind := NewWindow(nil, bounds, tPtr, false, documentProc, behind, goAway, refNum);
GetPort(savePort);
dummy := SkelWindow(editWind, @Mouse, @Key, @Update, @Activate, @Close, @Clobber, @Idle, true);
{ mouse click handler }
{ key click handler }
{ window updating procedure }
{ window activate/deactivate procedure }
{ window close procedure }
{ window disposal procedure }
{ idle proc }
{ idle only when frontmost }
{ Build the scroll bar.}
CalcScrollRect(r);
editScroll := NewControl(editWind, r, '', true, 0, 0, 0, scrollBarProc, longint(0));
{ Create the TE record used for text display. Use default}
{ characteristics.}
GetEditRect(r);
editTE := TENew(r, r);
SetClikLoop(@AutoScroll, editTE); { set autoscroll proc }
{$IFC not singleEdit}
{ Get new information structure, attach to list of known edit}
{ windows.}
eInfo := EIHandle(NewHandle(Size(sizeof(EditInfoRec))));
editInfo := eInfo;
eInfo^^.eNext := ewList;
ewList := eInfo;
eInfo^^.editWind := editWind;
eInfo^^.scroll := editScroll;
eInfo^^.editTE := editTE;
eInfo^^.bound := bound;
eInfo^^.editFile := editFile;
{$ENDC}
{ Install default event notification procedures, font characteristics.}
SetEWindowProcs(editWind, e_key, e_activate, e_close);
SetEWindowStyle(editWind, e_font, e_size, e_wrap, e_just);
SetDirty(false);
{ If supposed to read file, do so. Check the return value of}
{ Revert and toss the window if there was an error.}
if bindToFile then
if (Revert = false) then
begin
SkelRmveWind(editWind);
SetPort(savePort);
failure := true;
end;
end;
if not failure then
begin
{ Show window if specified as visible, and return a pointer to it.}
SyncGlobals(editWind);
OverhaulDisplay(true, true);
if visible then
ShowWindow(editWind);
SetPort(savePort);
NewEWindow := editWind;
end
else
NewEWindow := nil;
end;
{ Look through the list of windows, shutting down all the edit}
{ windows. If any window is dirty, ask user about saving it first.}
{ If the user cancels on any such request, ClobberEWindows returns}
{ false. If all edit windows are shut down, return true. It is}
{ then safe for the host to exit.}
{ When a window *is* shut down, have to start looking through the}
{ window list again, since theWind no longer points anywhere}
{ meaningful.}
function ClobberEWindows;
var
theWind: WindowPtr;
breakflag, flag2: Boolean;
mypeek: WindowPeek;
begin
breakflag := false;
while not breakflag do
begin
theWind := FrontWindow;
flag2 := false;
while (theWind <> nil) and not flag2 do { all edit windows are not shut down }
begin
if ISEWindow(theWind) then
flag2 := true
else
begin
mypeek := WindowPeek(theWind);
theWind := WindowPtr(mypeek^.nextWindow);
end;
end;
if theWind = nil then
begin
ClobberEWindows := true;
breakflag := true;
end
else
begin
if theWind <> FrontWindow then
begin
SelectWindow(theWind);
ShowWindow(theWind);
EWindowOverhaul(theWind, false, false, IsEWindowDirty(theWind));
SetPort(theWind);
ValidRect(theWind^.portRect);
end;
if EWindowClose(theWind) = false then { cancel or error }
begin
ClobberEWindows := false;
breakflag := true;
end;
end;
end;
end;
end.